home *** CD-ROM | disk | FTP | other *** search
/ TOS Silver 2000 / TOS Silver 2000.iso / programm / MM2_DEV / S / MOS / HDLERROR.I < prev    next >
Encoding:
Text File  |  1990-11-27  |  7.5 KB  |  3 lines
  1. ⓪ IMPLEMENTATION MODULE HdlError; (* V#062 *)⓪ (*$Y+,R-,M-*)⓪ ⓪ (*⓪!* Wenn ein Fehler nicht abgefangen wird, wird das Programm sofort mit⓪!* der Fehlernummer als Exitcode beendet.⓪!*⓪!* 25.11.90 TT  Um vorige Abfrage richtig zu machen (f. ModLoad), wird nun⓪!*              'Accessory' aus MOSCtrl statt der Funktion aus PrgCtrl⓪!*              abgefragt, weil PrgCtrl den akt. Status, MOSCtrl den Status⓪!*              des Base-Prozesses liefert.⓪!* 01.03.90 TT  In ACCs werden Exceptions nicht automatisch installiert⓪!* 17.06.89 TT  Undefinierte Fehlernummern bei GetErrorMsg werden nicht mehr⓪!*              abgeschnitten.⓪!* 25.10.88 TT  CatchRemoval-Aufruf⓪!* 01.09.88 TT  Sys-Funktion meldet nicht autom. ab, ebenso bleibt ErrHdl-⓪!*              Vektor erhalten, wenn bei Prozeßende nicht alle Catcher⓪!*              abgemeldet sind.⓪!*)⓪ ⓪ FROM SYSTEM IMPORT ADR,ADDRESS,BYTE,LONGWORD,TSIZE, WORD, ASSEMBLER;⓪ ⓪ FROM PrgCtrl IMPORT CatchProcessTerm, SetEnvelope, TermProcess,⓪(TermCarrier, EnvlpCarrier;⓪ ⓪ FROM MOSCtrl IMPORT BaseIsAccessory;⓪ ⓪ FROM SystemError IMPORT OutOfMemory;⓪ ⓪ FROM ResCtrl IMPORT RemovalCarrier, CatchRemoval;⓪ ⓪ FROM MOSGlobals IMPORT MemArea;⓪ ⓪ FROM MOSConfig IMPORT RuntimeErrMsg;⓪ ⓪ FROM Storage IMPORT SysAlloc, DEALLOCATE;⓪ ⓪ FROM SysTypes IMPORT ExcDesc;⓪ ⓪ FROM ErrBase IMPORT ErrResp, RtnCond, ErrHdl, ErrHdlProc, ExcInstalled,⓪0InstallExc, RemoveExc;⓪ ⓪ FROM Lists IMPORT SysCreateList, DeleteList, NextEntry, LCarrier, LDir,⓪(PrevEntry, AppendEntry, ResetList, List, ScanEntries, RemoveEntry,⓪(ListEmpty, CurrentEntry, EndOfList;⓪ ⓪ FROM StrConv IMPORT IntToStr;⓪ ⓪ FROM Strings IMPORT Assign, Pos, Delete, Insert;⓪ ⓪ (*⓪ TYPE    ErrProc = PROCEDURE (     (* errNo:   *) INTEGER,⓪B(* msg:     *) ARRAY OF CHAR,⓪B(* causer:  *) ErrResp,⓪B(* cont:    *) RtnCond,⓪>VAR (* excData: *) ExcDesc ): BOOLEAN;⓪ *)⓪ ⓪ TYPE ProcList  = POINTER TO ProcField;⓪%ProcField = RECORD⓪3call : ErrProc;⓪3stck : MemArea;⓪3level: INTEGER;⓪1END;⓪ ⓪ VAR ErrProcs: List;⓪$oldHdl: ErrHdlProc;⓪$Level: INTEGER;⓪ ⓪ PROCEDURE findProc ( p0,info:ADDRESS ):BOOLEAN;⓪"VAR p: ProcList;⓪"BEGIN⓪$p:=p0;⓪$RETURN ADDRESS(p^.call) = info;⓪"END findProc;⓪ ⓪ PROCEDURE install ( call:ErrProc; workSpace:MemArea; level:INTEGER ): BOOLEAN;⓪"VAR p: ProcList;⓪&err: BOOLEAN;⓪"BEGIN⓪$IF (workSpace.bottom#NIL) & (workSpace.length>=50L) THEN⓪&ResetList (ErrProcs);⓪&ScanEntries (ErrProcs,forward,findProc,ADDRESS(call),err);⓪&IF err THEN (* gefunden *) RETURN TRUE END;⓪&SysAlloc (p,SIZE(p^));⓪&IF p#NIL THEN⓪(AppendEntry (ErrProcs,p,err);⓪(IF err THEN⓪*DISPOSE (p)⓪(ELSE⓪*p^.call := call;⓪*p^.level:= level;⓪*p^.stck := workSpace;⓪*InstallExc;⓪*RETURN ExcInstalled⓪(END⓪&END⓪$END;⓪$RETURN FALSE⓪"END install;⓪ ⓪ PROCEDURE SysCatchErrors ( call: ErrProc; workSpace: MemArea ): BOOLEAN;⓪"(*$L-*)⓪"BEGIN⓪$ASSEMBLER⓪(; RETURN install (call,workSpace,0)⓪(MOVE    #-1,(A3)+⓪(JMP     install⓪$END⓪"END SysCatchErrors;⓪"(*$L=*)⓪ ⓪ PROCEDURE CatchErrors ( call: ErrProc; workSpace: MemArea ): BOOLEAN;⓪"(*$L-*)⓪"BEGIN⓪$ASSEMBLER⓪(; RETURN install (call,workSpace,Level)⓪(MOVE    Level,(A3)+⓪(JMP     install⓪$END⓪"END CatchErrors;⓪"(*$L=*)⓪ ⓪ ⓪ PROCEDURE ReleaseCatcher ( call: ErrProc );⓪"VAR p: ProcList; fnd:BOOLEAN;⓪"BEGIN⓪$ResetList (ErrProcs);⓪$ScanEntries (ErrProcs,forward,findProc,ADDRESS(call),fnd);⓪$IF fnd THEN (* gefunden *)⓪&p:= CurrentEntry (ErrProcs);⓪&DISPOSE (p);⓪&RemoveEntry (ErrProcs,fnd);⓪$END;⓪$IF BaseIsAccessory & ListEmpty (ErrProcs) THEN⓪&RemoveExc⓪$END⓪"END ReleaseCatcher;⓪ ⓪ ⓪ PROCEDURE getSt2 (ad:ADDRESS; n:INTEGER; VAR msg:ARRAY OF CHAR): BOOLEAN;⓪"VAR s: POINTER TO ARRAY [0..31] OF CHAR; ok:BOOLEAN;⓪"BEGIN⓪$ASSEMBLER⓪(MOVE.L  ad(A6),A0⓪(MOVE.W  n(A6),D0⓪(⓪%l: CMP.W   (A0)+,D0⓪(BNE     c⓪(⓪(; gefunden⓪(MOVE.L  A0,s(A6)⓪(BRA     e⓪(⓪%c: TST.B   (A0)    ; Listenende ?⓪(BEQ     f       ; Ja, -> nicht gefunden⓪(⓪%m: ADDA.W  #32,A0⓪(BRA     l⓪(⓪%f: CLR.L   s(A6)⓪%e:⓪$END;⓪$IF s#NIL THEN⓪&Assign (s^,msg,ok);⓪&RETURN TRUE⓪$ELSE⓪&RETURN FALSE⓪$END⓪"END getSt2;⓪ ⓪ PROCEDURE GetErrorMsg ( n: INTEGER; VAR msg: ARRAY OF CHAR );⓪"VAR p:INTEGER; m:POINTER TO RECORD no:INTEGER; t:ARRAY [0..31] OF CHAR END;⓪$ok:BOOLEAN;⓪"BEGIN⓪$msg[0]:=0C;⓪$IF RuntimeErrMsg=NIL THEN⓪&Assign ('Error #@',msg,ok)⓪$ELSE⓪&IF ~getSt2 (RuntimeErrMsg,n,msg) THEN⓪(m:=RuntimeErrMsg;⓪(Assign (m^.t,msg,ok)⓪&END⓪$END;⓪$p:=Pos ('@',msg,0);⓪$IF p>=0 THEN⓪&Delete (msg,p,1,ok);⓪&Insert (IntToStr(n,0),p,msg,ok)⓪$END⓪"END GetErrorMsg;⓪ ⓪ ⓪ PROCEDURE catch (no: INTEGER; msg: ARRAY OF CHAR; causer: ErrResp;⓪1cont: RtnCond; VAR info: ExcDesc);⓪"⓪"VAR ret: BOOLEAN;⓪"⓪"PROCEDURE callSub ( subRoutine: ErrProc; VAR wsp: MemArea );⓪$(*$L-*)⓪$BEGIN⓪&ASSEMBLER⓪*MOVE.L  -(A3),A0                ; ^wsp⓪*MOVE.L  -(A3),A1                ; subRoutine⓪*⓪*MOVE.L  A3,-(A7)                ; A3 retten⓪*MOVE.L  A7,D1                   ; alten SP laden zum Retten⓪*⓪*MOVE.L  MemArea.bottom(A0),A3   ; neuen SP-Bottom⓪*MOVE.L  A3,A7⓪*ADDA.L  MemArea.length(A0),A7⓪*⓪*; Parameter draufschaufeln⓪*MOVE    no(A6),(A3)+⓪*MOVE.L  msg(A6),(A3)+⓪*MOVE    msg+4(A6),(A3)+⓪*MOVE    causer(A6),(A3)+⓪*MOVE    cont(A6),(A3)+⓪*MOVE.L  info(A6),(A3)+⓪*⓪*MOVE.L  D1,-(A7)                ; alten SP retten⓪*JSR     (A1)⓪*MOVE    -(A3),D0⓪*EORI    #1,D0⓪*MOVE    D0,ret(A6)⓪*MOVE.L  (A7)+,A7⓪*MOVE.L  (A7)+,A3⓪&END⓪$END callSub;⓪$(*$L+*)⓪$⓪"VAR p: ProcList;⓪"BEGIN⓪$ResetList (ErrProcs);⓪$REPEAT⓪&p:= PrevEntry (ErrProcs);⓪&IF p=NIL THEN TermProcess (no) END;⓪&callSub (p^.call (*no,msg,causer,cont,info*), p^.stck );⓪$UNTIL ret⓪"END catch;⓪ ⓪ ⓪ PROCEDURE tstLevel ( p0,info:ADDRESS ):BOOLEAN;⓪"VAR p: ProcList;⓪"BEGIN⓪$p:=p0;⓪$RETURN p^.level >= Level⓪"END tstLevel;⓪ ⓪ PROCEDURE ReleaseLevel;⓪"VAR p: ProcList; fnd:BOOLEAN;⓪"BEGIN⓪$ResetList (ErrProcs);⓪$REPEAT⓪&ScanEntries (ErrProcs,forward,tstLevel,NIL,fnd);⓪&IF fnd THEN (* gefunden *)⓪(p:= CurrentEntry (ErrProcs);⓪(DISPOSE (p);⓪(RemoveEntry (ErrProcs,fnd);⓪&END⓪$UNTIL EndOfList (ErrProcs);⓪$IF BaseIsAccessory & ListEmpty (ErrProcs) THEN⓪&RemoveExc⓪$END⓪"END ReleaseLevel;⓪ ⓪ PROCEDURE ChgLevel ( start: BOOLEAN; inChild:BOOLEAN; VAR exitCode:INTEGER );⓪"BEGIN⓪$IF inChild THEN⓪&IF start THEN⓪(INC (Level);⓪&ELSE⓪(ReleaseLevel;⓪(DEC (Level)⓪&END⓪$END⓪"END ChgLevel;⓪ ⓪ PROCEDURE freeSys;⓪"VAR ok: BOOLEAN;⓪"BEGIN⓪$Level:= MinInt;⓪$ReleaseLevel;⓪$DeleteList (ErrProcs, ok);⓪$ErrHdl:= oldHdl⓪"END freeSys;⓪ ⓪ VAR err:BOOLEAN;⓪$wsp: MemArea;⓪$rHdl: RemovalCarrier;⓪$termHdl: TermCarrier;⓪$envHdl: EnvlpCarrier;⓪ ⓪ BEGIN⓪"Level:=0;⓪"wsp.bottom:=NIL;⓪"SysCreateList (ErrProcs, err);⓪"IF err THEN OutOfMemory END;⓪"oldHdl:= ErrHdl;⓪"ErrHdl:= catch;⓪"SetEnvelope (envHdl,ChgLevel,wsp);⓪"CatchProcessTerm (termHdl,ReleaseLevel,wsp);⓪"CatchRemoval (rHdl,freeSys,wsp);⓪"IF NOT BaseIsAccessory THEN⓪$InstallExc;⓪$IF NOT ExcInstalled THEN⓪&OutOfMemory⓪$END⓪"END⓪ END HdlError.⓪ ə
  2. (* $FFF2E42F$FFFA7DF8$FFFA7DF8$FFFA7DF8$FFFA7DF8$FFFA7DF8$FFFA7DF8$FFFA7DF8$FFFA7DF8$FFFA7DF8$FFFA7DF8$FFFA7DF8$FFFA7DF8$FFFA7DF8$FFFA7DF8$00000B61$FFFA7DF8$FFFA7DF8$FFFA7DF8$FFFA7DF8$FFFA7DF8$FFFA7DF8$FFFA7DF8$FFFA7DF8$FFFA7DF8$FFFA7DF8$FFFA7DF8$FFFA7DF8$FFFA7DF8$FFFA7DF8$FFFA7DF8$FFFA7DF8$FFFA7DF8$FFFA7DF8$FFFA7DF8$FFFA7DF8$FFFA7DF8$FFFA7DF8$FFFA7DF8$FFFA7DF8$FFFA7DF8$FFFA7DF8Ç$000001CAT.......T.......T.......T...T...T.......T.......T.......T.......T.......T.......$00000DE7$00000360$000001CD$000000C6$000001CA$FFEAC45A$000001CA$0000042E$00000DE7$00001828$00001B57$FFEA4FD0$00001831$00000DE7$00001831$00001B4A¼Çâ*)
  3.